home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / NEW / A-Newest / TORPET.d64 / keydef (.txt) < prev    next >
Commodore BASIC  |  2009-10-12  |  10KB  |  296 lines
  1. 0 REM *** KEYDEF: A KEYBOARD REDEFINITION PROGRAM FOR THE COMMODORE 64 ***
  2. 1 REM *** WILLIAM R FRENCHU, 106 B NASSAU ST.,PRINCETON NJ. 23.AUG 83 ***
  3. 2 REM *** INITIALIZATION ***
  4. 3 POKE 53280,PEEK(53281)
  5. 4 GOSUB 20000:PRINT "             LOADING DATA"
  6. 5 DIM D(194):GOSUB 5400:REM *** LOAD DVORAK DATA ***
  7. 6 GOSUB 6000:REM *** LOAD AND RUN SWAP ROUTINE ***
  8. 7 F1=1:REM *** SET F1 TO 0 FOR TAPE USE ***
  9. 8 IF F1=0 THEN 10
  10. 9 OPEN 15,8,15
  11. 10 DIM SA(3):REM *** STARTING ADDRESSES FOR KEY TABLES ***
  12. 20 SA(0)=60289:SA(1)=60354:SA(2)=60419:SA(3)=60536
  13. 30 DIM K$(255):GOSUB 10000:REM *** KEY LABELS ***
  14. 90 DIM OK(255),NK(255):REM *** OLD AND NEW KEY ARRAYS ***
  15. 117 DIM NE$(66):GOSUB 10500:REM *** NON ECHOING CHARACTERS ***
  16. 118 POKE 649,1:REM *** CHANGE KEYBOARD BUFFER LENGTH ***
  17. 119 :
  18. 120 GOSUB 20000:REM *** MAIN MENU ***
  19. 130 PRINT "                MENU 1"
  20. 140 PRINT "      1    LOAD DEFINITION FILE"
  21. 150 PRINT "      2    CREATE DEFINITION FILE"
  22. 170 PRINT "      3    SAVE DEFINITION FILE"
  23. 180 PRINT "      4    LOAD DVORAK KEYSET"
  24. 190 PRINT "      5    END PROGRAM"
  25. 200 PRINT "              OPTION? ";
  26. 209 GET A$
  27. 210 GET A$:IF A$<"1" OR A$>"5" THEN 210
  28. 220 PRINT A$:FOR I=0 TO 1000:NEXT
  29. 230 ON VAL(A$) GOTO 1000,2000,4000,5000,3000
  30. 998 :
  31. 999 :
  32. 1000 GOSUB 20000:REM *** LOAD AN EXISTING DEFINITION FILE ***
  33. 1009 GET A$
  34. 1010 INPUT "  FILENAME";NF$
  35. 1015 IF F1=0 THEN 1200
  36. 1020 NF$=NF$+",S,R"
  37. 1100 OPEN 8,8,8,NF$:REM *** DISK SECTION ***
  38. 1110 GOSUB 30000
  39. 1120 FOR I=0 TO 3
  40. 1122 FOR J=0 TO 63:L=64*I+J:INPUT#8,OK(L):POKE(SA(I)+J),OK(L):NEXT
  41. 1124 NEXT
  42. 1130 GOSUB 30000
  43. 1140 CLOSE 8
  44. 1150 GOTO 120
  45. 1200 OPEN 1,1,0,NF$ :REM *** TAPE SECTION ***
  46. 1220 FOR I=0 TO 3
  47. 1222 FOR J=0 TO 63:L=64*I+J:INPUT#1,OK(L):POKE(SA(I)+J),OK(L):NEXT
  48. 1224 NEXT
  49. 1240 CLOSE 1
  50. 1243 PRINT "        HIT ANY KEY TO CONTINUE"
  51. 1244 GET A$
  52. 1246 GET A$:IF A$="" THEN 1246
  53. 1250 GOTO 120
  54. 1997 :
  55. 1998 :
  56. 1999 REM *** CREATE NEW DEFINITION FILE ***
  57. 2000 POKE 788,52:REM *** DISABLE STOP KEY ***
  58. 2010 GOSUB 20000
  59. 2020 PRINT "                MENU 2"
  60. 2022 PRINT "   1    ASSIGN SHIFTS INDEPENDENTLY"
  61. 2024 PRINT "   2    ASSIGN SHIFTS SIMULTANEOUSLY"
  62. 2026 PRINT "              OPTION? ";
  63. 2027 GET A$
  64. 2028 GET A$:IF A$<"1" OR A$>"2" THEN 2028
  65. 2029 REM *** DELAY LOOP ***
  66. 2030 PRINT A$:FOR I=0 TO 1000:NEXT
  67. 2032 F=VAL(A$)-1:REM *** FLAG FOR ASSIGNING SHIFTED KEYS SIMULTANEOUSLY ***
  68. 2035 GOSUB 20000
  69. 2039 REM *** LOAD EXISTING DEFS INTO ARRAY ***
  70. 2040 PRINT "      LOADING CURRENT DEFINITIONS"
  71. 2100 FOR I=0 TO 3
  72. 2110 FOR J=0 TO 63:L=64*I+J:OK(L)=PEEK(SA(I)+J):NK(L)=OK(L):NEXT
  73. 2115 NEXT
  74. 2200 GOSUB 20000
  75. 2210 PRINT "   S[146] = SHIFT: C[146] = CTRL: C=[146] = COMMODORE"
  76. 2220 PRINT " PRESS STOP[146] TO EXIT OR ENTER CHR$ CODES"
  77. 2230 PRINT " [164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164][164]"
  78. 2240 PRINT "    KEY ";TAB(20);"ASSIGNMENT"
  79. 2250 PRINT "   LABEL";TAB(17);"CURRENT";TAB(29);"NEW"
  80. 2260 PRINT " [163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
  81. 2300 FOR I=0 TO 14
  82. 2305 IFPEEK(197)<>64 THEN2305
  83. 2306 PRINT"    [146]";
  84. 2307 IF F>1 THEN F=1
  85. 2310 K=PEEK(197):IF K=64 THEN 2310 :REM *** GET KEY NUMBER ***
  86. 2315 IF K=63 THEN 2600:REM *** STOP KEY? ***
  87. 2317 IF F=1 THEN J=0:GOTO 2330
  88. 2320 J=PEEK(653):IF J>4 THEN 2310:REM *** SHIFTED OR NOT ***
  89. 2325 GET A$:GET A$:IF J=4 THEN J=3
  90. 2330 L=64*J+K:REM *** INDEX FOR KEY ARRAY ***
  91. 2335 IF F=1 THEN PRINT "[157][157][157]*  ";
  92. 2340 IF OK(L)>32 GOTO 2345:REM *** CHECK FOR NON ECHOING CHARS ***
  93. 2343 PRINT "[157]";K$(L);TAB(18);NE$(OK(L));
  94. 2344 GOTO 2360
  95. 2345 IF OK(L)<128 OR OK(L)>160 GOTO 2350:REM ***CHECK FOR NON ECHOING CHARS ***
  96. 2347 PRINT "[157]";K$(L);TAB(18);NE$(OK(L)-95);
  97. 2348 GOTO 2360
  98. 2350 IFOK(L)<>34THEN2355
  99. 2352 PRINT "[157]";K$(L);TAB(18);NE$(66);
  100. 2354 GOTO2360
  101. 2355 PRINT "[157]";K$(L);TAB(18);CHR$(OK(L));
  102. 2360 IFPEEK(197)<>64THEN2360
  103. 2365 PRINT TAB(28);" [146]";
  104. 2370 K=PEEK(197):IF K=64 THEN 2370:REM *** GET KEY NUMBER OF NEW ASSIGNMENT ***
  105. 2380 IF K=63 AND F=0 THEN 2500:REM *** NEW ASSIGNMENT IS A CHR CODE ***
  106. 2382 IF K=63 THEN 2370:REM *** CANT REASSIGN STOP KEY ***
  107. 2385 IF F>0 THEN 2410 :REM *** ARE WE ASSIGNING THEM ALL AT ONCE? ***
  108. 2400 J=PEEK(653):IF J>4 THEN 2370:REM *** CHECK SHIFT ***
  109. 2405 GET A$:GET A$:IF J=4 THEN J=3
  110. 2407 REM *** GET NEW DEFINITION ***
  111. 2409 REM *** ASSIGNMENT SECTION FOR CHR CODES ***
  112. 2410 POKE 1,(PEEK(1)OR2):L1=PEEK(SA(J)+K):POKE 1,(PEEK(1)AND253)
  113. 2411 IF F>1 THEN 2430
  114. 2412 IF L1>32 GOTO 2415:REM *** CHECK FOR NON ECHOING CHARS ***
  115. 2413 PRINT "[157]";NE$(L1)
  116. 2414 GOTO 2430
  117. 2415 IF L1<128 OR L1>160 GOTO 2420
  118. 2416 PRINT "[157]";NE$(L1-95)
  119. 2417 GOTO 2430
  120. 2420 IF L1<>34 THEN2428
  121. 2422 PRINT "[157]";NE$(66)
  122. 2424 GOTO 2430
  123. 2428 PRINT "[157]";CHR$(L1)
  124. 2430 NK(L)=L1
  125. 2432 REM *** IF ALL SHIFTS ARE BEING ASSIGNED AT ONCE REPEAT ASSIGNMENT LOOP **
  126. 2435 IF F>0 AND J<3 THEN J=J+1:F=F+1:L=L+64:GOTO 2410
  127. 2450 IFPEEK(197)<>64THEN2450
  128. 2460 NEXT:GOTO 2200
  129. 2500 PRINT "[157][157]CHR$(       [157][157][157][157][157][157][157]";
  130. 2505 GET A$
  131. 2510 INPUT L1
  132. 2520 IF L1<0 OR L1>255 THEN PRINT"[157][157][157][157][157][157][157][157][157][157][157]"TAB(29);:GOTO 2500
  133. 2530 PRINT "[145]";TAB(32);L1;"[157])"
  134. 2540 GOTO 2430
  135. 2597 REM *** STOP KEY HAS BEEN PRESSED ***
  136. 2598 REM *** STORE THE NEW DEFINITIONS INTO KEYBOARD TABLE AND RETURN TO MAIN
  137. 2599 REM MENU SO WE CAN EXIT, SAVE OR MODIFY SOME MORE ***
  138. 2600 GOSUB 20000
  139. 2602 PRINT TAB(6);"STORING NEW SET IN KEY TABLE"
  140. 2605 FOR I=0 TO 3
  141. 2610 FOR J=0 TO 63:POKE(SA(I)+J),NK(64*I+J):NEXT
  142. 2620 NEXT
  143. 2625 POKE 788,49:REM *** RE-ENABLE STOP KEY ***
  144. 2630 GOTO 120
  145. 2997 :
  146. 2998 :
  147. 2999 REM *** ROUTINE FOR EXITING ***
  148. 3000 GOSUB 20000
  149. 3120 PRINT "                MENU 3"
  150. 3130 PRINT "   1    RESTORE ORIGINAL DEFINITIONS"
  151. 3150 PRINT "   2    RETAIN CURRENT DEFINITIONS"
  152. 3160 PRINT "              OPTION? ";
  153. 3170 GET A$
  154. 3210 GET A$:IF A$<"1" OR A$>"2" THEN 3210
  155. 3220 PRINT A$:FOR I=0 TO 1000:NEXT:REM *** DELAY LOOP ***
  156. 3225 POKE 649,10:REM *** RESTORE KEYBOARD BUFFER TO NORMAL LENGTH ***
  157. 3230 ON VAL(A$) GOTO 3300,3400
  158. 3299 REM *** TO RESTORE ORIGINAL SET, BANK ROM BACK IN ***
  159. 3300 GOSUB 20000
  160. 3310 PRINT "        ORIGINAL KEYSET RESTORED"
  161. 3320 POKE 1,(PEEK(1)OR2):CLOSE 15:END
  162. 3400 GOSUB 20000
  163. 3405 REM *** ELSE, JUST END ***
  164. 3410 PRINT "        CURRENT KEYSET RETAINED"
  165. 3420 CLOSE 15:END
  166. 3997 :
  167. 3998 :
  168. 3999 REM *** ROUTINE FOR SAVING DEFINITION SET ***
  169. 4000 GOSUB 20000
  170. 4005 GET A$
  171. 4010 INPUT "  FILENAME";NF$
  172. 4015 IF F1=0 THEN 4200
  173. 4020 NF$=NF$+",S,W":REM *** DISK SECTION ***
  174. 4100 OPEN 8,8,8,NF$
  175. 4110 GOSUB 30000
  176. 4120 FOR I=0 TO 3
  177. 4122 FOR J=0 TO 63:L=64*I+J:PRINT#8,PEEK(SA(I)+J);CHR$(13);:NEXT
  178. 4124 NEXT
  179. 4130 GOSUB 30000
  180. 4140 PRINT#8:CLOSE 8
  181. 4150 GOTO 120
  182. 4200 OPEN 1,1,1,NF$ :REM *** TAPE SECTION ***
  183. 4220 FOR I=0 TO 3
  184. 4222 FOR J=0 TO 63:L=64*I+J:PRINT#1,PEEK(SA(I)+J);CHR$(13);:NEXT
  185. 4224 NEXT
  186. 4240 PRINT#1:CLOSE 1
  187. 4243 PRINT "        HIT ANY KEY TO CONTINUE"
  188. 4244 GET A$
  189. 4246 GET A$:IF A$="" THEN 4246
  190. 4250 GOTO 120
  191. 4997 :
  192. 4998 :
  193. 4999 REM *** STORE DVORAK DATA IN KEYBOARD TABLE ***
  194. 5000 GOSUB 20000
  195. 5002 T=0:REM *** TOTAL FOR DATA CHECK ***
  196. 5005 PRINT "         LOADING DVORAK KEYSET"
  197. 5050 FOR I=0 TO 194
  198. 5070 POKE I+60289,D(I)
  199. 5080 T=T+D(I)
  200. 5090 NEXT
  201. 5095 IF T=22987 THEN 120
  202. 5100 PRINT "[147]      DATA ERROR IN DVORAK KEYSET"
  203. 5200 FOR I=0 T0 1500:NEXT:REM *** DELAY LOOP ***
  204. 5300 GOTO 3300
  205. 5399 REM *** SUBROUTINE FOR READING DVORAK DATA ***
  206. 5400 FOR I=0 TO 194:READ D(I):NEXT
  207. 5410 RETURN
  208. 5499 REM *** DVORAK DATA ARRANGED BY KEYNUMBER ***
  209. 5500 DATA 20,13,29,136,133,134,135,17,51,44,65,52,59,79,46,1,53,80,69,54,74,85
  210. 5510 DATA 89,81,55,70,73,56,88,68,71,75,57,67,72,48,77,84,82,66,43,76,78,45
  211. 5520 DATA 86,83,64,87,92,42,58,19,1,61,94,90,49,95,4,50,32,2,47,3,255
  212. 5530 DATA 148,141,157,140,137,138,139,145,35,60,193,36,93,207,62,1,37,208,197
  213. 5540 DATA 38,202,213,217,209,39,198,201,40,216,196,199,203,41,195,200,48
  214. 5550 DATA 205,212,210,194,219,204,206,221,214,211,186,215,169,192,91,147,1
  215. 5560 DATA 61,222,218,33,95,4,34,160,2,63,131,255
  216. 5570 DATA 148,141,157,140,137,138,139,145,150,60,176,151,93,185,62,1,152
  217. 5580 DATA 175,177,153,181,184,183,171,154,187,162,155,189,172,165,161,41
  218. 5590 DATA 188,180,48,167,163,178,191,166,182,170,220,190,174,164,179,168,223,91
  219. 5600 DATA 147,1,61,222,173,129,95,4,149,160,2,63,131,255
  220. 5996 :
  221. 5997 :
  222. 5998 REM *** DATA FOR ML ROUTINE THAT COPIES BASIC AND KERNAL INTO RAM ***
  223. 5999 REM *** CODE USES NO ABSOLUTE ADDRESSES SO MAY BE LOCATED ANYWHERE ***
  224. 6000 T=0:FOR I=0 TO 62:READ J:T=T+J:POKE 49152+I,J:NEXT
  225. 6010 IF T=10067 GOTO 6099:REM *** TOTAL FOR ML ROUTINE ***
  226. 6020 PRINT "[147]      DATA ERROR IN SWAP SUBROUTINE"
  227. 6030 FOR I=0 T0 1500:NEXT:REM *** DELAY LOOP ***
  228. 6040 GOTO 3300
  229. 6099 SYS 49152:RETURN:REM *** SWAP OUT BASIC AND KERNAL ***
  230. 6100 DATA 169,0,133,251,169,160,133,252,162,32,160,0,177,251,145,251,136
  231. 6110 DATA 240,2,208,247,202,240,4,230,252,208,238,169,0,133,251,169,224,133,252
  232. 6120 DATA 162,32,169,0,177,251,145,251,136,240,2,208,247,202,240,4,230,252,208
  233. 6130 DATA 238,165,1,41,253,133,1,96
  234. 9997 :
  235. 9998 :
  236. 9999 : REM *** ROUTINE FOR READING IN KEY LABELS ***
  237. 10000 FOR I=0 TO 255:READ K$(I):NEXT:RETURN
  238. 10001 DATA "DEL","RETURN","CRSR-R","F7","F1","F3","F5","CRSR-D","3"
  239. 10002 DATA "W","A","4","Z","S","E","N/A","5","R","D","6","C","F","T","X","7"
  240. 10003 DATA "Y","G","8","B","H","U","V","9","I","J","0","M","K","O","N","+","P"
  241. 10004 DATA "L","-",".",":","@",",","\","*",";","HOME","N/A","=","^","/"
  242. 10005 DATA "1","_","N/A","2","SPACE","N/A","Q","STOP"
  243. 10006 DATA "INST","S[146]RETURN","CRSR-L","F8","F2","F4","F6","CRSR-U","#"
  244. 10007 DATA "[215]","[193]","$","[218]","[211]","[197]","N/A","%","[210]","[196]","&","[195]","[198]","[212]","[216]","'"
  245. 10008 DATA "[217]","[199]","(","[194]","[200]","[213]","[214]",")","[201]","[202]","S[146]0","[205]","[203]","[207]","[206]","[219]"
  246. 10009 DATA "[208]","[204]","[221]",">","[","[186]","<","[169]","[192]","]","CLR","N/A","=","[255]","?"
  247. 10010 DATA "!","_","N/A","QUOTE","S[146]SPACE","N/A","[209]","RUN"
  248. 10011 DATA "C=[146]DEL","C=[146]RETURN","C=[146]CRSR-R","C=[146]F7"
  249. 10013 DATA "C=[146]F1","C=[146]F3","C=[146]F5","C=[146]CRSR-D","L.RED"
  250. 10015 DATA "[179]","[176]","GRY1","[173]","[174]","[177]","N/A"
  251. 10017 DATA "GRY2","[178]","[172]","L.GRN","[188]","[187]","[163]"
  252. 10019 DATA "[189]","L.BLU","[183]","[165]","GRY3","[191]"
  253. 10021 DATA "[180]","[184]","[190]","RVS-ON","[162]","[181]","RVS-OFF"
  254. 10023 DATA "[167]","[161]","[185]","[170]","[166]","[175]","[182]","[220]"
  255. 10025 DATA "C=[146].","C=[146]:","[164]","C=[146],","[168]","[223]","C=[146];","C=[146]HOME"
  256. 10027 DATA "N/A","C=[146]=","C=[146]^","C=[146]/","ORNG","C=[146]_","N/A"
  257. 10029 DATA "BRN","C=[146]SPACE","N/A","[171]","C=[146]STOP"
  258. 10032 DATA "C[146]DEL","C[146]RETURN","C[146]CRSR-R"
  259. 10033 DATA "C[146]F7","C[146]F1","C[146]F3","C[146]F5","C[146]CRSR-D","RED"
  260. 10034 DATA "C[146]W","C[146]A","CYN","C[146]Z","C[146]S","C[146]E","N/A"
  261. 10035 DATA "PUR","C[146]R","C[146]D","GRN","C[146]C","C[146]F","C[146]T","C[146]X","BLU"
  262. 10036 DATA "C[146]Y","C[146]G","YEL","C[146]B","C[146]H","C[146]U","C[146]V","RVS ON"
  263. 10037 DATA "C[146]I","C[146]J","RVS OFF","C[146]M","C[146]K","C[146]O","C[146]N","C[146]+"
  264. 10038 DATA"C[146]P","C[146]L","C[146]-","C[146].","C[146]:","C[146]@","C[146],","C[146]\"
  265. 10039 DATA"C[146]*","C[146];","C[146]HOME","N/A","C[146]=","C[146]^"
  266. 10040 DATA "C[146]/","BLK","C[146]_","N/A","WHT","C[146]SPACE","N/A","C[146]Q"
  267. 10041 DATA "C[146]STOP"
  268. 10497 :
  269. 10498 :
  270. 10499 REM *** ROUTINE FOR READING IN NON ECHOING CHARACTERS ***
  271. 10500 FOR I=0 TO 66:READ NE$(I)
  272. 10501 IFLEFT$(NE$(I),1)="*"THEN NE$(I)="CHR$("+RIGHT$(NE$(I),LEN(NE$(I))-1)+")"
  273. 10502 NEXT:RETURN
  274. 10505 DATA "*0","*1","*2","*3","*4","WHT","*6","*7"
  275. 10510 DATA "DIS C=[146]-S[146]","EN C=[146]-S[146]"
  276. 10520 DATA "*10","*11","*12","RETURN","L.CASE","*15"
  277. 10530 DATA "*16","CRSR-D","RVS-ON","HOME","DEL","*21","*22","*23"
  278. 10540 DATA "*24","*25","*26","*27","RED","CRSR-R","GRN","BLU","SPACE"
  279. 10550 DATA "*128","ORNG","*130","*131","*132","F1","F3","F5"
  280. 10560 DATA "F7","F2","F4","F6","F8","S[146]RETURN","U.CASE","*143"
  281. 10570 DATA "BLK","CRSR-U","RVS-OFF","CLR","INST","BRN","L.RED","GRY1","GRY2"
  282. 10580 DATA "L.GRN","L.BLU","GRY3","PUR","CRSR-L","YEL","CYN","S[146]SPACE","QUOTE"
  283. 20000 PRINT "[147] KEYDEF:A KEYBOARD REDEFINITION PROGRAM ":RETURN
  284. 29997 :
  285. 29998 :
  286. 29999 REM *** ROUTINE FOR CHECKING DISK ERRORS ***
  287. 30000 INPUT#15,E,E$
  288. 30020 IF E<20 THEN RETURN
  289. 30100 GOSUB 20000
  290. 30110 PRINT "      DISK ERROR";E;E$
  291. 30120 CLOSE 8
  292. 30130 PRINT "        HIT ANY KEY TO CONTINUE"
  293. 30135 GET A$
  294. 30140 GET A$:IF A$="" THEN 30140
  295. 30150 GOTO 120
  296.